perm filename WINTER.SAI[VIS,HPM]2 blob
sn#110599 filedate 1974-07-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "WINTER"
C00006 ENDMK
C⊗;
BEGIN "WINTER"
REQUIRE "WINNIC.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER ARRAY CHAN[0:5]; INTEGER WINDOW,I,J,MAC;
REAL SUM,TX,TY,T0; STRING FILN;
CHAN[0]←'32; CHAN[1]←'37; CHAN[2]←'33; CHAN[3]←'34; CHAN[4]←'35; CHAN[5]←'36;
DDINIT; SCREEN(-.2,1.2,1.2,-.2); DRKEN; RECTAN(-2,-2,2,2);
DO OUTSTR("FILENAME:") UNTIL
PIXDIM((FILN←INCHWL)&(IF FILN[∞ TO ∞]="]" THEN "" ELSE "[DAT,BGB]"));
OUTSTR("WINDOW SIZE:"); WINDOW←CVD(INCHWL); INIWIN(WINDOW);
OUTSTR("PICSIZ "&CVS(PICSIZ)&
" WIDTH "&CVS(PICWID)&" HEIGHT "&CVS(PICHIG)&" WINDOW "&CVS(WINDOW)&
" VERWIN "&CVS(VERWIN)&" HORWIN "&CVS(HORWIN)&'15&'12);
BEGIN INTEGER I,J; REAL X,Y;
INTEGER ARRAY PIC[1:PICSIZ],WINS[-1:VERWIN,1:HORWIN];
TX←WINDOW/PICWID;
TY←WINDOW/PICHIG;
GETPIX(PIC[1]);
OUTSTR("DISPLAY?"); IF INCHWL="Y" THEN
BEGIN
FOR I←1 STEP 1 UNTIL 5 DO DPYUP('36);
LITEN; TXTPOS(0,1.2,.04,-.08); TEXT(FILN); DRKEN;
FOR I←4 STEP -1 UNTIL (5-PICBIT) MAX 0 DO
BEGIN
RECTAN(0,0,1,1);
VIDEO(0,0,1,1,PIC[1],2↑(PICBIT+I-5));
FOR J←1 STEP 1 UNTIL 5 DO DPYUP(CHAN[I]);
END;
END;
RECTAN(-2,-2,2,2); LITEN;
FOR J←0 STEP 1 UNTIL HORWIN DO
BEGIN
X←J*TX;
LINE(X,0,X,-.02); LINE(X,1,X,1.02);
END;
FOR I←0 STEP 1 UNTIL VERWIN DO
BEGIN
Y←I*TY;
LINE(0,Y,-.02,Y); LINE(1,Y,1.02,Y);
END;
DPYUP(CHAN[5]);
SETFORMAT(0,2);
T0←CALL(0,"RUNTIM"); SUM←DOWIN(PIC[1],WINS[1,1]);
OUTSTR("TIME "&CVF((CALL(0,"RUNTIM")-T0)/1000)&'15&'12);
FOR I←1 STEP 1 UNTIL VERWIN DO
FOR J←1 STEP 1 UNTIL HORWIN DO
BEGIN INTEGER II,JJ,WMAX;
X←(J-1)*TX;
Y←(I-1)*TY;
IF (WINS[I,J] LAND 1)=0 ∧ WINS[I,J]>SUM THEN
BEGIN
LINE(X,Y,X+TX,Y);
LINE(X+TX,Y,X+TX,Y+TY);
LINE(X+TX,Y+TY,X,Y+TY);
LINE(X,Y+TY,X,Y);
END;
END;
FOR I←1 STEP 1 UNTIL 5 DO DPYUP(CHAN[5]);
MAKPIX(VERWIN,HORWIN,6);
BEGIN
INTEGER ARRAY POUT[1:PICSIZ];
FOR I←1 STEP 1 UNTIL VERWIN DO FOR J←1 STEP 1 UNTIL HORWIN
DO PUTEL(POUT[1],I,J,63*SQRT(WINS[I,J]/MAC));
PUTPIX(POUT[1],"TMP.TMP");
END;
END;
END;